home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Mega Archive 1
/
Atari Mega Archive - Volume 1.iso
/
graphics
/
tabplot.arc
/
TAB_PLOT.LST
< prev
next >
Wrap
File List
|
1988-05-01
|
13KB
|
659 lines
' ===========================================================
' TAB_PLOT version 0.2 April 1988
' written by Robert Best, Aragon 1, 3831ET Leusden, Nederland
' ===========================================================
Dim Q$(75) ! menu
For I%=0 To 75
Read Q$(I%)
Exit If Q$(I%)="***"
Next I%
Q$(I%)=""
Data Desk, TAB_PLOT 0.2,-------------------,-,-,-,-,-,-,""
Data Plot, Line 1, Dots 1, Line 2, Dots 2, Invers,--------, Save, Print,""
Data Scale, Xleft, Xright, Xdiv, Xlog,---------, Ydown 1, Ytop 1, Ydiv 1
Data Ylog 1,---------, Ydown 2, Ytop 2, Ydiv 2, Ylog 2,""
Data Text, at X-axis, at Y-axis 1 , at Y-axis 2, below plot
Data movable 1, movable 2,""
Data Table, Show, XYY-columns , Nr of rows, Next, Quit,"",***
Menu Q$()
Openw 0
Wh%=Peek(&HFF8241) Mod 2 ! 1=white 0=black background
1:
On Error Gosub Wrong
Cls
Deftext ,0,0,13
Print At(34,2);"Number table"
Fileselect "\*.*","",F$
If F$=""
End
Endif
If F$="\"
Goto 1
Endif
Cls
Print At(30,10);"Loading table "+F$
Open "I",#1,F$
T$=Space$(Lof(#1))
Close #1
Bload F$,Varptr(T$)
Cls
P%=Instr(T$,"===") ! table header
Gosub Digit
Q%=Instr(P%,T$,Chr$(13))
C%=0
Repeat ! find number of columns C%
P%=Instr(P%,T$," ")
Inc C%
Gosub Digit
Until P%>Q%
P%=Instr(T$,"===")
Gosub Digit
R%=0
Repeat ! find number of rows R%
P%=Instr(P%,T$,Chr$(13))
Inc R%
Gosub Digit
Until A%=0 ! end of T$
R1%=R% ! see Nr of rows
X%=1
Y1%=2
If C%=2 Or C%=3
Y2%=-C%*(C%=3)
Else
Gosub Column
Endif
Gosub Analyse
Gosub Plot
On Menu Gosub Select
Do
On Menu
Loop
' ================= main procedures =============
Procedure Column
A:
Gosub Input1("Select column 1-"+Str$(C%)+" for X",*X%)
Gosub Input1("Select column 1-"+Str$(C%)+" for Y",*Y1%)
M$=Chr$(10)+Chr$(10)+Chr$(13)+Space$(16)+"or type 0 if you don't want a second Y"
Gosub Input1("Select column 1-"+Str$(C%)+" for second Y"+M$,*Y2%)
If X%<1 Or X%>C% Or Y1%<1 Or Y1%>C% Or Y2%<0 Or Y2%>C%
Goto A
Endif
Return
Procedure Analyse
Cls
Erase X()
Erase Y1()
Dim X(R%),Y1(R%)
Gosub Fill(*X(),X%,"X")
Gosub Range(*X()) ! for automatic scaling
Xmi=Mi
Xo=Mi ! Xo can be changed, Xmi not
Xe=Ma
Gosub Fill(*Y1(),Y1%,"Y 1")
Gosub Range(*Y1())
Y1mi=Mi
Y1o=Mi
Y1e=Ma
If Y2%
Erase Y2()
Dim Y2(R%)
Gosub Fill(*Y2(),Y2%,"Y 2")
Gosub Range(*Y2())
Y2mi=Mi
Y2o=Mi
Y2e=Ma
Dot2%=1
Y2div%=5
Endif
Dot1%=1
Xdiv%=8
Y1div%=5
Clr X$,Y1$,Y2$,B$,Xlog%,Y1log%,Y2log%
Erase M$()
Erase H%()
Erase V%()
Dim M$(2),H%(2),V%(2)
Gosub Menu
Return
Procedure Plot
Cls
Box 64,8,576,328
Deftext ,,900,6
Text 10,250,Y1$
Deftext ,,0,6
Text 200,360,X$
Text 10,378,B$
Text H%(1),V%(1),M$(1) ! see Proc. Move
Text H%(2),V%(2),M$(2)
Defnum 3
On 1+Xlog% Gosub Xlinscale,Xlogscale
On 1+Y1log% Gosub Y1linscale,Y1logscale
If Dot1% ! draw dots
Deftext ,,,4
For I%=1 To R%
Gosub Screencoord(X(I%),Y1(I%),Y1log%,Y1o,Y1e,Sy1)
If H%*V%
Text H%-2,V%+2,"O"
Endif
Next I%
Else ! draw line
Gosub Screencoord(X(1),Y1(1),Y1log%,Y1o,Y1e,Sy1)
J%=H%
K%=V%
For I%=2 To R%
Gosub Screencoord(X(I%),Y1(I%),Y1log%,Y1o,Y1e,Sy1)
If J%*K%*H%*V%
Line J%,K%,H%,V%
Endif
J%=H%
K%=V%
Next I%
Endif
If Y2%
Deftext ,,900,6
Text 637,250,Y2$
Deftext ,,0,6
On 1+Y2log% Gosub Y2linscale,Y2logscale
If Dot2%
Deftext ,,,4
For I%=1 To R%
Gosub Screencoord(X(I%),Y2(I%),Y2log%,Y2o,Y2e,Sy2)
If H%*V%
Text H%-2,V%+2,"O"
Endif
Next I%
Else
Gosub Screencoord(X(1),Y2(1),Y2log%,Y2o,Y2e,Sy2)
J%=H%
K%=V%
For I%=2 To R%
Gosub Screencoord(X(I%),Y2(I%),Y2log%,Y2o,Y2e,Sy2)
If J%*K%*H%*V%
Line J%,K%,H%,V%
Endif
J%=H%
K%=V%
Next I%
Endif
Endif
Deftext ,,,13
Return
Procedure Select
Menu Off
A$=Q$(Menu(0))
If A$=" TAB_PLOT 0.2"
Alert 0,"Plot program|for scientists",1,"Return",I%
Endif
If A$=" Line 1"
Dot1%=0
Endif
If A$=" Dots 1"
Dot1%=1
Endif
If A$=" Line 2"
Dot2%=0
Endif
If A$=" Dots 2"
Dot2%=1
Endif
If A$=" Invers"
W%=Peek(&HFF8241) Mod 2
Setcolor 0,1-W%
Endif
If A$=" Save"
Gosub Save(1)
Endif
If A$=" Print"
Gosub Save(0)
Endif
If A$=" Xleft"
S1:
Print At(11,20);"Xleft ="'Xo,
Gosub Input2(Xo,*Xo)
If Xo>=Xe Or (Xlog% And Xo<=0)
Goto S1
Endif
Menu 24,2+(Xmi>0)*(Xo>0)
Endif
If A$=" Xright"
S2:
Print At(11,20);"Xright ="'Xe,
Gosub Input2(Xe,*Xe)
If Xe<=Xo
Goto S2
Endif
Endif
If A$=" Xdiv"
S3:
Print At(11,20);"Xdiv ="'Xdiv%,
Gosub Input2(Xdiv%,*Xdiv%)
If Xdiv%<1
Goto S3
Endif
Endif
If A$=" Xlog"
Xlog%=1-Xlog%
Menu 24,Xlog%
Menu 23,3-Xlog%
Endif
If A$=" Ydown 1"
S4:
Print At(11,20);"Ydown 1 ="'Y1o,
Gosub Input2(Y1o,*Y1o)
If Y1o>=Y1e Or (Y1log% And Y1o<=0)
Goto S4
Endif
Menu 29,2+(Y1mi>0)*(Y1o>0)
Endif
If A$=" Ytop 1"
S5:
Print At(11,20);"Ytop 1 ="'Y1e,
Gosub Input2(Y1e,*Y1e)
If Y1e<=Y1o
Goto S5
Endif
Endif
If A$=" Ydiv 1"
S6:
Print At(11,20);"Ydiv 1 ="'Y1div%,
Gosub Input2(Y1div%,*Y1div%)
If Y1div%<1
Goto S6
Endif
Endif
If A$=" Ylog 1"
Y1log%=1-Y1log%
Menu 29,Y1log%
Menu 28,3-Y1log%
Endif
If A$=" Ydown 2"
S7:
Print At(11,20);"Ydown 2 ="'Y2o,
Gosub Input2(Y2o,*Y2o)
If Y2o>=Y2e Or (Y2log% And Y2o<=0)
Goto S7
Endif
Menu 34,2+(Y2mi>0)*(Y2o>0)
Endif
If A$=" Ytop 2"
S8:
Print At(11,20);"Ytop 2 ="'Y2e,
Gosub Input2(Y2e,*Y2e)
If Y2e<=Y2o
Goto S8
Endif
Endif
If A$=" Ydiv 2"
S9:
Print At(11,20);"Ydiv 2 ="'Y2div%,
Gosub Input2(Y2div%,*Y2div%)
If Y2div%<1
Goto S9
Endif
Endif
If A$=" Ylog 2"
Y2log%=1-Y2log%
Menu 34,Y2log%
Menu 33,3-Y2log%
Endif
If A$=" at X-axis"
Print At(11,20);
Line Input "Text at X-axis: ",X$
Endif
If A$=" at Y-axis 1 "
Print At(11,20);
Line Input "Text at Y1-axis: ",Y1$
Endif
If A$=" at Y-axis 2"
Print At(11,20);
Line Input "Text at Y2-axis: ",Y2$
Endif
If A$=" below plot"
Print At(11,19);
Line Input "Text below plot: ",B$
Endif
If A$=" movable 1"
Gosub Move(1)
Endif
If A$=" movable 2"
Gosub Move(2)
Endif
If A$=" Show"
Gosub Show
Endif
If A$=" XYY-columns "
Gosub Column
Gosub Analyse
Endif
If A$=" Nr of rows"
S10:
Gosub Input1("Type number of rows",*R%)
If R%<2 Or R%>R1%
Goto S10
Endif
Gosub Analyse
Endif
If A$=" Next"
Run
Endif
If A$=" Quit"
Setcolor 0,Wh%
End
Endif
Gosub Plot
Return
' ================= other procedures ==============
Procedure Wrong
If Err=10
Alert 0,"Sorry, file too long,|more than 32 kB",1,"Return",I%
Close #1
Else
Alert 0,"Error "+Str$(Err),1,"Return",I%
Endif
Resume 1
Return
Procedure Menu
Menu 24,2+(Xo>0)*(Xmi>0) ! Xlog inactive if Xo<=0 or Xmi<=0
Menu 24,Xlog% ! checkmark
Menu 23,3-Xlog% ! Xdiv inactive if Xlog
Menu 29,2+(Y1o>0)*(Y1mi>0)
Menu 29,Y1log%
Menu 28,3-Y1log%
If Y2%
Menu 34,2+(Y2o>0)*(Y2mi>0)
Menu 34,Y2log%
Menu 33,3-Y2log%
Else ! deactivate
Menu 13,2
Menu 14,2
For I%=31 To 34
Menu I%,2
Next I%
Menu 39,2
Endif
Return
Procedure Digit
Repeat ! find next digit
A%=Asc(Mid$(T$,P%,1))
Exit If A%>47 And A%<58
Inc P%
Until A%=0 ! end of T$
Return
Procedure Number
Repeat ! find next digit or dot or minus
A%=Asc(Mid$(T$,P%,1))
Exit If A%>44 And A%<58 And A%<>47
Inc P%
Until A%=0
L%=Instr(P%,T$," ")-P